#lang racket


(require "../global.rkt"
         "../ast/main.rkt"
         "../base/main.rkt"
         "../backends/main.rkt")

(provide
 ; evaluate
 evaluate
 evaluate-toplevel
 
 ; lang
 bbox
 par
 
 ; properties
 curve-begin-coord
 curve-end-coord
 
 surface-curvature
 surface-domain
 
 ; cad
 begin-undo-mark
 delete-shape
 end-undo-mark
 get-shapes
 render-shape
 undo
 view
 view-2d-top)


(define (current-in-fn fn)
  (fn (current-in-backend)))

(define (current-out-fn fn)
  (fn (current-out-backend)))

(define (warn-abort (exp (void)))
  (displayln "Warning: no backend selected; shapes will not be created")
  exp)


; evaluate

(define (evaluate exp)
  (if current-out-backend
      ((current-out-fn backend-evaluate) exp)
      exp))

(define (evaluate-toplevel exp)
  (if current-out-backend
      ((current-out-fn backend-evaluate-toplevel) exp)
      exp))


; lang

(define (bbox node)
  (if current-out-backend
      ((current-out-fn backend-bbox) (evaluate-toplevel node))
      (warn-abort bbox-zero)))

(define (par node)
  (if current-out-backend
      ((current-out-fn backend-par) (evaluate-toplevel node))
      (warn-abort)))


; properties

(define (curve-begin-coord node)
  (if current-out-backend
      ((current-out-fn backend-curve-begin-coord) (evaluate-toplevel node))
      (warn-abort u0)))

(define (curve-end-coord node)
  (if current-out-backend
      ((current-out-fn backend-curve-end-coord) (evaluate-toplevel node))
      (warn-abort u0)))

(define (surface-curvature node)
  (if current-out-backend
      ((current-in-fn backend-surface-curvature) (evaluate-toplevel node))
      (warn-abort)))

(define (surface-domain node)
  (if current-out-backend
      ((current-in-fn backend-surface-domain) (evaluate-toplevel node))
      (warn-abort)))


; cad

(define (begin-undo-mark)
  (if current-out-backend
      ((current-out-fn backend-begin-undo-mark))
      (warn-abort)))

(define (delete-shape shape)
  (if current-out-backend
      ((current-out-fn backend-delete-shape) shape)
      (warn-abort)))

(define (end-undo-mark)
  (if current-out-backend
      ((current-out-fn backend-end-undo-mark))
      (warn-abort)))

(define (get-shapes)
  (if current-out-backend
      ((current-out-fn backend-get-shapes))
      (warn-abort (list))))

(define (render-shape width height path)
  (if current-out-backend
      ((current-out-fn backend-render-shape) width height path)
      (warn-abort)))

(define (undo)
  (if current-out-backend
      ((current-out-fn backend-undo))
      (warn-abort)))


; view

(define (view-impl type)
  (if current-out-backend
      ((current-out-fn backend-view) type)
      (warn-abort)))

(define view
  (case-lambda
    (()
     (view-impl (auto-view-type)))
    ((center target)
     (view-impl (manual-view-type center target (perspective-projection-type) 50)))
    ((center target projection)
     (view-impl (manual-view-type center target (perspective-projection-type) 50)))
    ((center target projection lens)
     (view-impl (manual-view-type center target (make-projection-type projection) lens)))))

(define (view-2d-top (center u0))
  (view center (xyz 0 0 -1) '2d))

; /view